perm filename INTERP.OPL[HAL,HE] blob
sn#122336 filedate 1974-10-03 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00007 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 .SBTTL Interpreter
C00005 00003 GETARG:
C00009 00004 Flow-of-control routines
C00011 00005 Routines which return scalars
C00016 00006 Routines which return vectors
C00022 00007 routines which return a trans
C00024 ENDMK
C⊗;
.SBTTL Interpreter
;Register uses in the interpreter:
; R3 interpreter stack pointer
; R4 points to interpreter status block
;Interpreter status block
II == 0
XX SR0 ;Saved R0 (across waits)
XX SR1 ;Saved R1 (across waits)
XX SR2 ;Saved R2 (across waits)
XX SR3 ;Saved R3 (across waits)
XX SR4 ;Saved R4 (across waits)
XX SRF ;Saved RF (across waits)
XX SSP ;Saved SP (across waits)
XX SPC ;Saved PC (across waits)
XX IPC ;Interpreter program counter
XX ICR ;Interpreter cross-reference (to HAL code)
XX BASE ;Stack base for this lexical level, dynamic level
XX LEV ;Lexical level of current execution
ISBS = II/2 ;Size (in words) of interpreter status block
;Interpreter itself
INTERP: MOV @IPC(R4),R0 ;R0 ← next instruction
BLT INTER1 ;Instruction out of range
CMP R0,INSEND ;Is instruction too large?
BHI INTER1 ;Yes.
ADD #2,IPC(R4) ;Bump IPC
JSR PC,@INTOPS(R0) ;Call the appropriate routine
BVC INTERP ;If all went well, do another instruction
BR INTERR(R0) ;Else go to the right error routine.
INTER1: HALERR INTMS1
INTMS1: ASCIE /INTERPRETER INSTRUCTION OUT OF RANGE/
INTERR: JMP RUG
JMP RUG
JMP RUG ;Temporarily a cop-out.
INTOPS: GTVAL ;Push value of arg.
CHNGE ;Pop value into arg.
SAS ;S+S: Add top two elts, pop, pop, push answer
SMS ;S*S: Mul top two elts, pop, pop, push answer
SDS ;S/S: Div top two elts, pop, pop, push answer
NS ;-S: Negate top elt, pop, push answer
VDV ;S ← vector dot vector
PDV ;Scalar ← plane dot vector
NRMV ;Scalar ← norm of vector
SMV ;Vector ← scalar * vector
UNITV ;Vector ← vector / its norm
CROSV ;Vector ← vector cross vector
TMV ;Vector ← trans * vector
INSEND = .-INTOPS;Marks the end of the instructions
GETARG:
;This routine returns in R0 a pointer to the graph node which
; is the argument of an interpreter instruction, and it sets the
; IPC to point to the next instruction.
;The format for arguments: In the word following the instruction
; the low order byte is the lexical level, and the high byte is the
; offset.
;It is assumed that the first word of a data area is the static link
; to the next (outer, that is, lower-numbered) lexical level's data area.
MOV R2,-(SP) ;Save R2
MOV @IPC(R4),R0 ;R0 ← word following instruction
ADD #2,IPC(R4) ;New IPC
MOVB R0,R1 ;R1 ← Lexical level
CLRB R0 ;
SWAB R0 ;R0 ← Offset
MOV BASE(R4),R2 ;R2 ← LOC[base of current data area]
SUB LEV(R4),R1 ;R1 ← Difference in levels: desired-got
BEQ GTRG1 ;Diff=0; can use R2 as pointer at right base.
GTRG2: MOV (R2),R2 ;No, must go up a level. R2 ← LOC[base of upper area]
INC R1 ;R1 ← New difference in levels
BNE GTRG2 ;If not yet good, then move up another level
GTRG1: ADD R2,R0 ;R0 ← base + offset = location of desired pointer
MOV (R0),R0 ;R0 ← LOC[desired graph node]
MOV (SP)+,R2 ;Restore R2.
RTS PC ;Done.
GETSCA: ;Gets place for a scalar result, and places a pointer on
;the interpreter stack. Location is returned in R0.
;Simple procedure.
; MOV #2,R0 ;Number of words needed
; JSR PC,GETSMA ;R0 ← LOC[new block]
MOV #RES,R0 ;Temporary kludge. Delete this line in final runs.
MOV R0,-(R3) ;Push new value cell pointer on interpreter stack.
RTS PC ;Done
GETVEC: ;Gets place for a vector result, and places a pointer on
;the interpreter stack. Location is returned in R0.
;Simple procedure.
; MOV #10,R0 ;Number of words needed
; JSR PC,GETSMA ;R0 ← LOC[new block]
MOV #RES,R0 ;Temporary kludge. Delete this line in final runs.
MOV R0,-(R3) ;Push new value cell pointer on interpreter stack.
RTS PC ;Done
GTVAL: JSR PC,GETARG ;R0 ← argument
CALL GETVAL,<R0>;R0 ← value
MOV R0,-(R3) ;Push value on interpreter stack.
CLV ;Set completion code
RTS PC ;Done
CHNGE: JSR PC,GETARG ;R0 ← argument
CALL CHANGE,<R0,(R3)>
TST (R3)+ ;Pop stack
CLV ;Set completion code
RTS PC ;Done
;Flow-of-control routines
;Procedure call. Arguments:
; Destination.
; List of variables which are to be inserted in appropriate
; locations in the local storage of procedure. These are
; in the format variable (ie level-offset pair), new offset
; (right justified in the second word).
;The destination address contains these words:
; Number of words to get from free storage for local variable pointers
;Value parameters are copied first into local temps (which have been
; arranged by the compiler), and then the temps are passed by
; reference. Eventual problem: to know which variables to
; really kill as the procedure is exited.
PROC:
MOV @IPC(R4),R2 ;R2 ← LOC[destination]
ADD #2,IPC(R4) ;Bump IPC
MOV (R2),R0 ;R0 ← Number of words to get.
JSR PC,GTFREE ;
;Routines which return scalars
;All timings are averages of 1000 runs. They take into account
;the cost of the RTS but not the JSR. It is assumed that GETSCA
;and GETVEC take no time.
;30 microseconds
SAS: ;Scalar ← Scalar + Scalar
LDF @(R3)+,AC0 ;AC0 ← arg 2
ADDF @(R3)+,AC0 ;AC0 ← arg2 + arg1
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
RTS PC ;Done
;30 microseconds
SMS: ;Scalar ← scalar * scalar
LDF @(R3)+,AC0 ;AC0 ← arg 2
MULF @(R3)+,AC0 ;AC0 ← arg2 * arg1
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
RTS PC ;Done
;33 microseconds
SDS: ;Scalar ← Scalar / Scalar
LDF @(R3)+,AC1 ;AC1 ← arg 2
LDF @(R3)+,AC0 ;AC0 ← arg 1
DIVF AC1,AC0 ;AC0 ← arg1 / arg2
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
RTS PC ;Done
;26 microseconds
NS: ;Scalar ← -Scalar
LDF @(R3)+,AC0 ;AC0 ← arg
NEGF AC0 ;AC0 ← -arg
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
RTS PC ;Done
;96 -- 116 microseconds
VDV: ;Scalar ← Vector dot Vector
;S ← (X1X2 + Y1Y2 + Z1Z2) / W1W2
MOV R2,-(SP) ;Save R2.
MOV (R3)+,R1 ;R1 ← LOC[arg 2]
MOV (R3)+,R0 ;R0 ← LOC[arg 1]
CLRF AC0 ;AC0 ← 0. Running total
MOV #3,R2 ;R2 ← 3: Length of vector
VDV1: LDF (R0)+,AC1 ;Form sum of products of first 3 terms
MULF (R1)+,AC1 ;
ADDF AC1,AC0 ;
SOB R2,VDV1 ;Loop until all 3 fields done.
DIVF (R0),AC0 ;Divide by W1
DIVF (R1),AC0 ;Divide by W2. AC0 now has answer.
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
;103 -- 116 microseconds
PDV: ;Scalar ← Plane dot Vector
;S ← X1X2 + Y1Y2 + Z1Z2 + W1W2
MOV R2,-(SP) ;Save R2.
MOV (R3)+,R1 ;R1 ← LOC[arg 2]
MOV (R3)+,R0 ;R0 ← LOC[arg 1]
CLRF AC0 ;AC0 ← 0. Running total
MOV #4,R2 ;R2 ← 4: Length of vector and weight
PDV1: LDF (R0)+,AC1 ;Form sum of products of all 4 terms
MULF (R1)+,AC1 ;
ADDF AC1,AC0 ;
SOB R2,PDV1 ;Loop until all 3 fields done.
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
;199 -- 207 microseconds
NRMV: ;Scalar ← Norm (vector)
;S ← SQRT(XX + YY+ ZZ) / W
MOV (R3)+,R1 ;R1 ← LOC[arg]
LDF (R1)+,AC0 ;AC0 ← X
MULF AC0,AC0 ;AC0 ← XX
LDF (R1)+,AC1 ;AC1 ← Y
MULF AC1,AC1 ;AC1 ← YY
ADDF AC1,AC0 ;AC0 ← XX + YY
LDF (R1)+,AC1 ;AC1 ← Z
MULF AC1,AC1 ;AC1 ← ZZ
ADDF AC1,AC0 ;AC0 ← XX + YY + ZZ
MOV R1,-(SP) ;Push LOC[W] onto system stack, to save across SQRTF
JSR PC,SQRTF ;AC0 ← SQRT(XX + YY + ZZ)
DIVF @(SP)+,AC0 ;AC0 ← AC0 / W
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store answer
RTS PC ;Done
;Routines which return vectors
;83 -- 91 microseconds
SMV: ;Vector ← Scalar * Vector
;X ← S*X, Y ← S*Y, Z ← S*Z, W ← W
MOV R2,-(SP) ;Save R2
MOV (R3)+,R1 ;R1 ← LOC[vector]
LDF @(R3)+,AC0 ;AC0 ← scalar;
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector block]
MOV #3,R2 ;R2 ← 3: How many fields to handle
SMV1: LDF (R1)+,AC1 ;AC1 ← next field of vector
MULF AC0,AC1 ;AC1 ← product
STF AC1,(R0)+ ;Store result
SOB R2,SMV1 ;Loop until all 3 fields done.
MOV (R1)+,(R0)+ ;Transfer W
MOV (R1)+,(R0)+ ; which is 2 words long.
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
;281 -- 286 microseconds
UNITV: ;Vector ← V / Norm(V)
;S ← SQRT(XX + YY+ ZZ) / W
MOV R2,-(SP) ;Save R2
MOV (R3),R1 ;R1 ← LOC[arg]
LDF (R1)+,AC0 ;AC0 ← X
MULF AC0,AC0 ;AC0 ← XX
LDF (R1)+,AC1 ;AC1 ← Y
MULF AC1,AC1 ;AC1 ← YY
ADDF AC1,AC0 ;AC0 ← XX + YY
LDF (R1)+,AC1 ;AC1 ← Z
MULF AC1,AC1 ;AC1 ← ZZ
ADDF AC1,AC0 ;AC0 ← XX + YY + ZZ
MOV R1,-(SP) ;Save R1 across SQRTF
JSR PC,SQRTF ;AC0 ← SQRT(XX + YY + ZZ)
MOV (SP)+,R1 ;Restore R1
DIVF (R1),AC0 ;AC0 ← Norm = SQRT / W
MOV (R3)+,R1 ;R1 ← LOC[arg]
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector block]
MOV #3,R2 ;R2 ← count of fields
UNITV1: LDF (R1)+,AC1 ;AC1 ← field of vector
DIVF AC0,AC1 ;divide by norm
STF AC1,(R0)+ ;Store result
SOB R2,UNITV1 ;Loop until done
MOV (R1)+,(R0)+ ;Copy W.
MOV (R1),(R0) ; (two words long)
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
;172 -- 184 microseconds
CROSV: ;Vector ← Vector cross Vector
;X ← Y1Z2 - Y2Z1
;Y ← X2Z1 - X1Z2
;Z ← X1Y2 - X2Y1
;W ← W1W2
;AC0, 1, 2, 3, 4, 5 are garbaged by this routine.
MOV R2,-(SP) ;Save R2
MOV (R3),R2 ;R2 ← LOC[arg 2]
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector block]
MOV 4(R3),R1 ;R1 ← LOC[arg 1]. Must not pop R3 stack yet!
LDF 14(R1),AC0 ;AC0 ← W1
MULF 14(R2),AC0 ;AC0 ← W1W2
STF AC0,14(R0) ;Store AC0 → W
LDF 4(R1),AC0 ;AC0 ← Y1
LDF (R2),AC1 ;AC1 ← X2
LDF 4(R2),AC2 ;AC2 ← Y2
LDF (R1),AC3 ;AC3 ← X1
STF AC3,AC4 ;AC4 ← X1
STF AC0,AC5 ;AC5 ← Y1
MULF AC2,AC3 ;AC3 ← X1Y2
MULF AC1,AC0 ;AC0 ← X2Y1
SUBF AC0,AC3 ;AC3 ← X1Y2 - X2Y1
STF AC3,10(R0) ;Z ← AC3
LDF 10(R2),AC0 ;AC0 ← Z2
LDF 10(R1),AC3 ;AC3 ← Z1
MULF AC4,AC0 ;AC0 ← X1Z2
MULF AC3,AC1 ;AC1 ← X2Z1
SUBF AC0,AC1 ;AC1 ← X2Z1 - X1Z2
STF AC1,4(R0) ;Y ← AC1
LDF 10(R2),AC0 ;AC0 ← Z2
MULF AC5,AC0 ;AC0 ← Y1Z2
MULF AC2,AC3 ;AC3 ← Y2Z1
SUBF AC3,AC0 ;AC0 ← Y1Z2 - Y2Z1
STF AC0,(R0) ;X ← AC0
MOV (R3)+,2(R3) ;Put result cell where first argument was
TST (R3)+ ;Put stack pointer in right place
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
;283 -- 324 microseconds
TMV: ;Vector ← Trans * Vector
MOV R2,-(SP) ;Save R2
MOV (R3),R2 ;R2 ← LOC[vector]
MOV 2(R3),R0 ;R0 ← LOC[trans]
CLRF AC1 ;X ← 0
CLRF AC2 ;Y ← 0
CLRF AC3 ;Z ← 0
MOV #4,R1 ;R1 ← How many columns left to go
TMV1: LDF (R2)+,AC0 ;AC0 ← field of vector
STF AC0,AC5 ;AC5 ← copy of AC0
MULF (R0)+,AC0 ;
ADDF AC0,AC1 ;Add partial result to X
LDF AC5,AC0 ;Restore AC0
MULF (R0)+,AC0 ;
ADDF AC0,AC2 ;Add partial result to Y
LDF AC5,AC0 ;Restore AC0
MULF (R0)+,AC0 ;
ADDF AC0,AC3 ;Add partial result to Z.
TST (R0)+ ;Skip bottom row
TST (R0)+ ; (2 words long)
SOB R1,TMV1 ;Go back to do all 4 columns.
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector]
STF AC1,(R0)+ ;Store X
STF AC2,(R0)+ ;Store Y
STF AC3,(R0)+ ;Store Z
MOV -4(R2),(R0)+;Copy W from the vector
MOV -2(R2),(R0) ; (2 words long)
MOV (R3)+,2(R3) ;Put result cell where first argument was
TST (R3)+ ;Put stack pointer in right place
MOV (SP)+,R2 ;Restore R2
RTS PC ;Done
;routines which return a trans